perm filename NETWRK.FAI[S,NET]8 blob sn#722355 filedate 1983-08-03 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00032 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00005 00002	Network routines, intended to be .INSERT'ed
C00010 00003	 INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND ERRBTS WINBTS ICP NET DAT NW%SU NW%ARP NW$BYT NT$NUM NE%UNT NE%STR NN%IP NW%ARP NW%SI NW%SU
C00014 00004	 NWKDBG HSTADR HSTTOP HDBPTR DHSTST CONBLK CONSTS CONLSK CONWAT CONBYT ICPSKT CONFSK HOST CONHST LSNBLK LSNSTS LSNSKT LSNWAT LSNBYT LSNFSK LSNHST OPNBLK NETDEV
C00017 00005	 WATBLK WATSTS WATSKT INRBLK INRSTS INRSKT INSBLK INSSTS INSSKT WHYWHY IPHOST NTIBF NTOBF DTIBF DTOBF RMKBLK RMKSTS RMKDAT FSOCKT LSOCKT
C00019 00006	 CONECT .CONEC .CONC1
C00024 00007	 LISTEN .LISTE .LSTN1
C00027 00008	 DATI .DATI .DATI1
C00029 00009	 DATO .DATO .DATO1
C00031 00010	 NETICH NETICW NTICH2 NTICH4 NTICH3 NTICH1 NTIC1A
C00035 00011	 NETOCH .NETOC
C00036 00012	 NETSND .NETSN NETOER
C00038 00013	 DATICH DATICW DTICH2 DTICH3 DTICH1 DTIC1A
C00042 00014	 DATOCH .DATOC
C00043 00015	 DATSND .DATSN DATOER
C00045 00016	 CLOSER CLSDAT
C00046 00017	 NETINR NETINS
C00047 00018	 MTPERR MTPER1 MTPE1A MERTAB MERLEN
C00051 00019	 NIOERR
C00052 00020	 HSTDED
C00055 00021	 HSTDE2
C00057 00022	 HSTSID HSTFN1 HSTVRS HSTDIR HSTMCH HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV SITLEN NMLSIT NMRNAM NAMLEN NW%CHS NW%ARP NW%RCC NW%DLN NW%DSK NW%LCS NW%SU NW$BYT HSTFIL HSTPPN HSTSID HSTFN1 HSTVRS HSTDIR HSTDEV HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NTNPTR HDRLEN NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADLXXX ADRSVC SVLCNT SVRCDR SVLFLG SVRNAM SVCARG ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV STFGWY SITLEN NMLSIT NMRNAM NAMLEN NNLNET NNRNAM NTNLEN HSTFIL HSTPPN
C00077 00023	 MAPHST
C00079 00024	 UNMHST
C00080 00025	 HSTNUM HSTNU0 HSTNUS HSTNU1 HSTNU2 HSTNU3 HSTNU4 HSTNU5 HSTNUD HSTNUO HSTNU9
C00086 00026	 HSTNAM CNTCHR
C00088 00027	 SEARCH SRCNXW SRCWIN SRCLUZ SRCDUN GOTNAM AMBNAM GETHDB
C00093 00028	 HSTNXA
C00095 00029	 SETANM SETA00 SETAN1 SETAN0 SETAN2 SETAN4 SETAN5 SETAN9 SETAN6 SETAN7 SETAN8
C00099 00030	 H2TOIP H2ARP H2ARP1 H2ARP2 H2SU
C00101 00031	 IPTOH2 IPTH2A IPARP IPARP1 IPSU
C00103 00032	 CPOPJ2 CPOPJ1 CPOPJ WARNIN LUZBIG ..NLIT NW%ARP NW%SU NW$BYT
C00104 ENDMK
C⊗;
SUBTTL Network routines, intended to be .INSERT'ed

; Mark Crispin, SU-AI, April 1978

;  This is a library of ARPAnet hacking routines.  Each routine describes its
; calling sequence and what AC's it smashes.  A pushdown stack is expected in 17.
;  I/O channel 0 is smashed, I/O channel 1 (NET) is used as the general TELNET
; connection channel, and I/O channel 2 (DAT) is used for data I/O.
;  Bugs → MRC.

;  This package can also be used with the Ethernet as well, but data connections
; are not implemented. Also, Ethernet does not have equivalent to INTINR, and
; simply sends an INTINS. Host down messages are bogus. (TVR/Dec81)

;  Modified for ARPAnet IP/TCP in April 1983.  Major change is the elimination
; of ICP for ARPAnet connections.  Bugs → ME and JJW.

;  Changed host table to use HOSTS3 format, using FTHST3 switch (JJW - June 83).

;  This is the FAIL version which lives in NETWRK.FAI[S,NET].  The MIDAS version
; lives in NETWRK.MID[S,NET].

; Assembly switches

IFNDEF FTHST3,<FTHST3←←1>		; ≠ 0 → use HOSTS3 rather than HOSTS2
IFNDEF SVRRTS,<SVRRTS←←0>		; ≠ 0 → server (not user) routines
IFNDEF DATRTS,<DATRTS←←0>		; ≠ 0 → data channel routines
IFNDEF MRKCHR,<MRKCHR←←0>		; ≠ 0 → pass BSP mark bytes as characters
IFNDEF ERRHAN,<ERRHAN←←0>		; ≠ 0 → automagic error reporting in NIORTS
IFNDEF ERRINS,<ERRINS←←<047000,,12>>	; (iff ERRHAN≠0) what to do after an error
IFNDEF HSTSIX,<HSTSIX←←0>		; ≠ 0 → sixbit alias name hacking

IFNDEF NIORTS,<NIORTS←←SVRRTS!DATRTS!ERRHAN> ; ≠ 0 → network I/O routines

IFNDEF ERRTNS,<ERRTNS←←ERRHAN>		; ≠ 0 → error reporting routines

IFNDEF HSTTAB,<HSTTAB←←HSTSIX>		; ≠ 0 → host table routines

IFE NIORTS!ERRTNS!HSTTAB,<.FATAL No NETWRK routines selected>
IFE NIORTS,<IFN SVRRTS!DATRTS!ERRHAN,<.FATAL NIORTS Illegal switch setting>>
IFE ERRTNS,<IFN ERRHAN,<.FATAL ERRHAN Illegal switch setting>>
IFE HSTTAB,<IFN HSTSIX,<.FATAL HSTTAB Illegal switch setting>>
IFE NIORTS,<IFN MRKCHR,<.FATAL MRKCHR Illegal switch setting>>

; Macro definitions

; FATAL errors type an exclamation point and halt.  WARNings type a question
; mark and continue.

DEFINE FATAL(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING?\] ↔ JRST LUZBIG]>
DEFINE WARN(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING!\] ↔ JRST WARNIN]>

; Timeouts for various flavors of connection

IFNDEF CNTIMO,<CNTIMO←←<BYTE (6)1,0,0,=15,5,0>>		; Connect ICP
IFNDEF LSTIMO,<LSTIMO←←<BYTE (6)1,=10,=10,=30,0,0>>	; Listen ICP
IFNDEF TNTIMO,<TNTIMO←←<BYTE (6)1,=15,0,5,0,0>>		; Telnet socket
IFNDEF DATIMO,<DATIMO←←<BYTE (6)2,24,0,7,0,0>>		; Data socket

IFN FTHST3,<
;Macro to zero all but network number in a word.  Placed outside .BEGIN so
;programs .INSRTing this file can use it.

DEFINE GETNET(AC,ADDR)<
IFDIF <ADDR><><MOVE AC,ADDR>
	TLNN AC,(17⊗=32)	; Check for non-Internet type addrs
	 TLNN AC,(1⊗=31)	;  Internet address, see if class A net
	  TDZA AC,[77,,-1]	;   Unternet or class A, zap low 3 octets
	TLNN AC,(1⊗=30)		; Class B or C, see which.
	 TRZA AC,177777		;  Class B network, zap low 2 octets
	  TRZ AC,377		;   Class C net, only zap 1 low octet
>;GETNET
>;IFN FTHST3
;⊗ INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND ERRBTS WINBTS ICP NET DAT NW%SU NW%ARP NW$BYT NT$NUM NE%UNT NE%STR NN%IP NW%ARP NW%SI NW%SU

; System bits and bytes

BEGIN NETWRK

; Goddam bagbiting assembler!!!

GLOBAL NIORTS,ERRHAN,ERRINS,ERRTNS,HSTTAB,SVRRTS,DATRTS,HSTSIX,MRKCHR,FTHST3
DEFINE FATAL(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING?\] ↔ JRST LUZBIG]>
DEFINE WARN(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING!\] ↔ JRST WARNIN]>

; Interrupt condition bits

↑INTINR←←<000100,,0>			; IMP INR
↑INTINS←←<000040,,0>			; IMP INS
↑INTIMS←←<000020,,0>			; IMP status change
↑INTINP←←<000010,,0>			; IMP input waiting

; Network socket status flags

↑RFCS←←  <200000,,0>			; RFC sent
↑RFCR←←  <100000,,0>			; RFC received
↑CLSS←←  <040000,,0>			; CLS sent
↑CLSR←←  <020000,,0>			; CLS received

; Network status word error codes

↑SIU←←01				; socket in use
↑CCS←←02				; can't change socket numbers
↑SYS←←03				; horrible system error
↑NLA←←04				; no links available
↑ILB←←05				; illegal byte size
↑IDD←←06				; IMP dead
↑GMM←←07				; Gender mismatch

; I/O status word error bits

↑IOIMPM←←400000				; improper mode
↑IODERR←←200000				; hard device error
↑IODTER←←100000				; soft device error
↑IOBKTL←←040000				; block number out of bounds
↑IODEND←←020000				; end of file

ERRBTS←←<IOIMPM!IODERR!IODTER!IOBKTL!IODEND>
WINBTS←←<RFCS!RFCR>			; connection winning

; I/O channel definitions

ICP←←0					; channel to get socket from logger
↑NET←←1					; channel to do real network hacking
↑DAT←←2					; channel to do data hacking

; Network numbers (for distinguishing IMP from local Ethernet)
IFE FTHST3,<
IFE HSTTAB,<	;If not defined later.
NW%SU←←44	;SUnet
NW%ARP←←12	;Arpa net
NW$BYT←←331100	;Byte pointer to network number
>;IFE HSTTAB
>;IFE FTHST3
IFN FTHST3,<
↑NT$NUM←←301400		;Byte pointer to network number (high 12 bits)
↑NE%UNT←←<040000,,0>	;Escape bit indicating "Unternet" type address
↑NE%STR←←<100000,,0>	;Escape bit indicating "string" type address
↑NN%IP←←<740000,,0>	;host number bits that are off for all IP addresses
↑NW%ARP←←<12⊗=24>	;HOSTS3 uses full word network # values
↑NW%SI←←44⊗=24		;Internet address of SU-NET-TEMP
↑NW%SU←←NE%UNT+NW%SI	;"Unternet" used for Stanford Ethernet
>;IFN FTHST3
;⊗ NWKDBG HSTADR HSTTOP HDBPTR DHSTST CONBLK CONSTS CONLSK CONWAT CONBYT ICPSKT CONFSK HOST CONHST LSNBLK LSNSTS LSNSKT LSNWAT LSNBYT LSNFSK LSNHST OPNBLK NETDEV

; Data area

NWKDBG:	0				; -1 → do OUTCHR on network I/O

IFN HSTTAB,<

; Host table pointers

↑HSTADR:BLOCK 1				; ≠ 0 → address of beginning of host table
	BLOCK 1				; = 0 → host table not in core
HSTTOP:	BLOCK 1				; top of host table (JOBFF at map time)
HDBPTR:	BLOCK 1				; pointer to relative HDB

; Block for ASCIZ text of dotted host number of host not in table
DHSTST:	BLOCK 10

>; End IFN HSTTAB

IFN NIORTS,<

; CONNECT MTAPE block

CONBLK:	0				; CONNECT
CONSTS:	BLOCK 1				; returned status bits
CONLSK:	BLOCK 1				; local socket
CONWAT:	BLOCK 1				; ≠ 0 → wait for connection until timeout
CONBYT:	BLOCK 1				; byte size
↑ICPSKT:
CONFSK:	BLOCK 1				; foreign socket
↑HOST:
CONHST:	BLOCK 1				; foreign host

IFN SVRRTS,<

; LISTEN MTAPE block

LSNBLK:	1				; LISTEN
LSNSTS:	BLOCK 1				; returned status bits
↑LSNSKT:BLOCK 1				; local socket to listen to
LSNWAT:	BLOCK 1				; ≠ 0 → wait for connection
LSNBYT:	BLOCK 1				; byte size
LSNFSK:	BLOCK 1				; foreign socket
LSNHST:	BLOCK 1				; foreign host

>; End IFN SVRRTS

IFN NIORTS!SVRRTS,<
OPNBLK:	0
NETDEV: 'IMP',,0			; device name
	 NTOBF,,NTIBF			; buffers
	
>; End IFN NIORTS!SVRRTS
;⊗ WATBLK WATSTS WATSKT INRBLK INRSTS INRSKT INSBLK INSSTS INSSKT WHYWHY IPHOST NTIBF NTOBF DTIBF DTOBF RMKBLK RMKSTS RMKDAT FSOCKT LSOCKT

; More data area, shared by USER and SERVER

; WAIT MTAPE block

WATBLK:	4				; WAIT
WATSTS:	BLOCK 1				; returned status bits
WATSKT:	BLOCK 1				; socket number

; INTERRUPT MTAPE blocks

INRBLK:	11				; SEND INTERRUPT
INRSTS:	BLOCK 1				; returned status bits
INRSKT:	BLOCK 1				; socket number

INSBLK:	11
INSSTS:	BLOCK 1
INSSKT:	BLOCK 1

; Other stuff

WHYWHY:	BLOCK 1				; host down word
IFE FTHST3,<
↑IPHOST:BLOCK 1				; ≠ 0 if host number in IP format
>;IFE FTHST3

; I/O buffer headers

NTIBF:	BLOCK 3				; network input buffer header
NTOBF:	BLOCK 3				; network output buffer header

IFN DATRTS,<
DTIBF:	BLOCK 3				; network data input buffer header
DTOBF:	BLOCK 3				; network data output buffer header
>; End IFN DATRTS

IFN MRKCHR,<
RMKBLK:	26				; READ MARK
RMKSTS:	BLOCK 1
RMKDAT:	BLOCK 1				; mark byte returned here
>; End IFN MRKCHR

; Base sockets, set up by CONECT and LISTEN

↑FSOCKT:BLOCK 1				; foreign base socket
↑LSOCKT:BLOCK 1				; local base socket

>; End IFN NIORTS
;⊗ CONECT .CONEC .CONC1

; CONECT -- Connect to foreign host
; Call:	MOVEM <host number>,HOST
;	MOVEM <ICP socket number>,ICPSKT
;	PUSHJ 17,CONECT
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.  For IFE FTHST3, if IPHOST is 0 when CONECT is called, HOST
; is assumed to be in HOSTS2 format.  If IPHOST is non-0, then HOST must be in
; IP format.

IFN NIORTS,<

IFE SVRRTS,<

; Open channels and set timeouts

↑CONECT:
IFN ERRHAN,<
	PUSHJ 17,.CONEC
	 JRST [PUSHJ 17,MTPERR ↔ ERRINS]
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.CONEC:
IFE FTHST3,<
	SKIPE IPHOST			; IP host number given?
	TDZA 0,0			; Yes, use default net (ARPA)
	LDB [NW$BYT,,HOST]		; check network type
	SETZ 1,
	CAIN NW%SU			; Ethernet?
	 MOVEI 1,'PUP'
	SKIPE 0				; No net specified means ARPANet
	CAIN NW%ARP			; ARPANet?
	 MOVEI 1,'IMP'			; yes, use IMP
	JUMPE 1,[MOVE [360,,IOIMPM]	; if unknown name, fake an IMP code
		 MOVEM WHYWHY		;    to indicate inaccessibility.
		 JRST CPOPJ1]
	MOVSM 1,NETDEV			; specify device for OPEN
	SETZ
	CAIN 1,'PUP'
	 DPB [NW$BYT,,HOST]		; don't confuse PUPSER with network ID
	SKIPN IPHOST
	 CAIE 1,'IMP'
	  JRST .CONC1			; Jump if no host number conversion
	PUSH 17,HOST			; Save old host number in case needed
	MOVE 0,HOST
	PUSHJ 17,H2TOIP			; Convert to IP address for IMP
	 CAIA				; Damn!  Hope the system can handle this
	MOVEM 0,HOST
.CONC1:
>;IFE FTHST3
IFN FTHST3,<
	GETNET 0,HOST			; check network type
	MOVEI 1,'IMP'			; Assume not PUP
	CAMN 0,[NW%SU]			; Ethernet?
	 MOVEI 1,'PUP'			; Yes, use PUP
	MOVSM 1,NETDEV			; specify device for OPEN
	CAIN 1,'PUP'
	 HRRZS HOST			; Don't confuse PUPSER with net number
>;IFN FTHST3
	OPEN NET,OPNBLK			; open NET in ASCII mode
	 FATAL Network device INIT failure
	MTAPE NET,[17 ↔ CNTIMO]
	SETOM CONLSK			; gensym local socket
	SETOM CONWAT			; do wait until timeout
	MTAPE NET,CONBLK		; connect → foreign server
IFE FTHST3,<
	SKIPN IPHOST
	 CAIE 1,'IMP'
	  CAIA				; Skip if no host number conversion
	   POP 17,HOST			; Get back old host number
>;IFE FTHST3
	MOVE CONLSK			; get gensymmed socket
	MOVEM LSOCKT			; save local base socket
	MOVE CONSTS			; check for MTAPE error
	MOVEM WHYWHY
	TRNE 77
	 POPJ 17,
	GETSTS NET,			; check for I/O error on proper channel
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE WHYWHY
	TLC (WINBTS)			; for next instruction to win
	TLCE (WINBTS)			; legal socket state?
	 POPJ 17,
	MOVE CONFSK			; get socket we got
	MOVEM CONFSK			; and save it back
	MOVEM FSOCKT			; save foreign socket for later
	MOVE CONLSK			; for completeness and compatibilty
	MOVEM INSSKT
	MOVEI =8			; change byte size in buffer header
	DPB [300600,,NTIBF+1]
	DPB [300600,,NTOBF+1]
	INBUF NET,
	OUTBUF NET,
	MTAPE NET,[17 ↔ TNTIMO]
	MTAPE NET,[10]
	 CAI
	JRST CPOPJ2

>; End IFE SVRRTS
;⊗ LISTEN .LISTE .LSTN1

; LISTEN -- Listen for an ICP from a foreign host
; Call:	MOVEM <ICP socket number>,LSNSKT
;	MOVEM <device name>,NETDEV	;If omitted, then use IMP
;	PUSHJ 17,LISTEN
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return--host we connected to in HOST>
; Smashes 0 and 1.  For IFE FTHST3, if IPHOST is 0 when LISTEN is called, HOST
; is returned in HOSTS2 format.  If IPHOST is non-0, then HOST is returned in IP
; format.

IFN SVRRTS,<

; Open channels and set timeouts (punts after a minute)

↑LISTEN:
IFN ERRHAN,<
	PUSHJ 17,.LISTE
	 JRST [PUSHJ 17,MTPERR ↔ ERRINS]
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.LISTE:	OPEN NET,OPNBLK			; open NET in ASCII mode
	 FATAL Network device INIT failure
	MOVS 1,NETDEV
	MTAPE ICP,[17 ↔ LSTIMO]		; set timeouts
	SETOM LSNWAT			; do wait until timeout
	MTAPE NET,LSNBLK
IFE FTHST3,<
	SKIPN IPHOST
	 CAIE 1,'IMP'
	  JRST .LSTN1
	MOVE 0,LSNHST
	PUSHJ 17,IPTOH2			; Get host number in HOSTS2 format
	 CAIA				; Oh well, we tried
	MOVEM 0,LSNHST
.LSTN1:
>;IFE FTHST3
	MOVE LSNSTS			; check for MTAPE error
	MOVEM WHYWHY
	TRNE 77
	 POPJ 17,
	GETSTS NET,			; check for I/O error
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE WHYWHY
	TLC (WINBTS)			; for next instruction to win
	TLCE (WINBTS)			; legal socket state?
	 POPJ 17,
	MOVE LSNHST
	MOVEM CONHST
	MOVE LSNFSK
	MOVEM FSOCKT			; save foreign base socket
	MOVE LSNSKT			; remember local socket
	MOVEM LSOCKT
	MOVEM INSSKT			; for completeness, set this as well
	MOVEI =8			; change byte size in buffer header
	DPB [300600,,NTIBF+1]
	DPB [300600,,NTOBF+1]
	INBUF NET,
	OUTBUF NET,
	MTAPE NET,[17 ↔ TNTIMO]
	MTAPE NET,[10]
	 CAI
	JRST CPOPJ2

>; End IFN SVRRTS
;⊗ DATI .DATI .DATI1

; DATI -- Open data input network channel
; Call:	PUSHJ 17,DATI
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return--byte size in 0>
; Smashes 0 and 1.

IFN DATRTS,<

↑DATI:
IFN ERRHAN,<
	PUSHJ 17,.DATI
	 JRST [PUSHJ 17,MTPERR ↔ ERRINS]
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.DATI:	CHNSTS DAT,			; check for channel open
	JUMPN .DATI1
	INIT DAT,0			; open channel
	 ('IMP')
	 DTOBF,,DTIBF			; buffers
	 FATAL IMP INIT failure
	MTAPE DAT,[17 ↔ DATIMO]
.DATI1:	MOVE LSOCKT
	ADDI 4				; ICP/U receive data offset
	MOVEM CONLSK			; local receive socket
	MOVE FSOCKT
	ADDI 3				; ICP/S transmit data offset
	MOVEM CONFSK			; foreign transmit socket
	SETOM CONWAT			; wait
	MTAPE DAT,CONBLK		; connect ← foreign data output
	MOVE CONSTS			; test for error
	MOVEM WHYWHY
	TRNE 77
	 POPJ 17,
	GETSTS DAT,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE WHYWHY
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,
	MTAPE DAT,[15 ↔ 1]		; system maximum allocation
	MOVE CONBYT			; change byte size in buffer header
	DPB [300600,,DTIBF+1]
	INBUF DAT,
	MTAPE DAT,[10]
	 CAI
	JRST CPOPJ2
;⊗ DATO .DATO .DATO1

; DATO -- Open data output network channel
; Call:	MOVEI <byte size of connection>
;	PUSHJ 17,DATO
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

↑DATO:
IFN ERRHAN,<
	PUSHJ 17,.DATO
	 JRST [PUSHJ 17,MTPERR ↔ ERRINS]
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.DATO:	MOVEM CONBYT
	CHNSTS DAT,
	JUMPN .DATO1
	INIT DAT,0			; open channel
	 ('IMP')
	 DTOBF,,DTIBF			; buffers
	 FATAL IMP INIT failure
	MTAPE DAT,[17 ↔ DATIMO]
.DATO1:	MOVE LSOCKT
	ADDI 5				; ICP/U transmit data offset
	MOVEM CONLSK			; local receive socket
	MOVE FSOCKT
	ADDI 2				; ICP/S receive data offset
	MOVEM CONFSK			; foreign transmit socket
	SETOM CONWAT			; wait
	MTAPE DAT,CONBLK		; connect → foreign data input
	MOVE CONSTS			; test for error
	MOVEM WHYWHY
	TRNE 77
	 POPJ 17,
	GETSTS DAT,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE WHYWHY
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,
	MOVE CONBYT			; change byte size in buffer header
	DPB [300600,,DTOBF+1]
	OUTBUF DAT,
	JRST CPOPJ2

>; End IFN DATRTS
;⊗ NETICH NETICW NTICH2 NTICH4 NTICH3 NTICH1 NTIC1A

; NETICH/NETICW -- Read a character from the network
; Call:	PUSHJ 17,NETICH or PUSHJ 17,NETICW
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<error return--no characters available> iff NETICH
;	<return--character in 0>
; Smashes 0, 1, and 2.

↑NETICH:TDZA 2,2			; don't hang
↑NETICW: SETO 2,			; hang
IFN ERRHAN,<
	PUSHJ 17,NTICH2
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	 POPJ 17,			; NETICW or empty NETICH
	JRST CPOPJ1			; NETICH return
>; End IFN ERRHAN
NTICH2:	SOSLE NTIBF+2			; anything in buffer?
	 JRST NTICH3
	JUMPN 2,NTICH4
	HRRZ 1,NTIBF
	HRRZ 1,(1)
	SKIPGE (1)			; anything in further buffers?
	 JRST NTICH4
	MTAPE NET,[10]			; no, any input available?
	 JRST CPOPJ1			; no, empty error return
NTICH4:	IN NET,				; yes, read the buffer
	 JRST NTICH3			; won
	GETSTS NET,			; error, get status
IFN MRKCHR,<
	TRNN 0,IOBKTL			; mark seen?
>; End IFN MRKCHR
	POPJ 17,			; I/O error return
IFN MRKCHR,<
	MTAPE NET,RMKBLK		; read mark byte
	 POPJ 17,			; failed
	MOVE 0,RMKDAT
	TRO 0,400			; send it in specially marked package
	JRST CPOPJ2			; good return
>; End IFN MRKCHR
NTICH3:	IBP NTIBF+1			; increment pointer to hack
	MOVE @NTIBF+1			; get word to hack
	ANDI 17 			; only marking bits
	JFFO NTICH1			; count leading zeros
	LDB NTIBF+1			; get the character
	SKIPE NWKDBG
	 OUTCHR
	JUMPN 2,CPOPJ1			; NETICW only skips once
	JRST CPOPJ2			; NETICH good return

; Have to flush nulls here.

NTICH1:	MOVNI 1,-44(1)			; get -1,,# of padding characters
	HRRZM 1,1(17)			; stash # of characters away on stack
	MOVEI 1,-1(1)			; # of characters to take off buffer
	SUBM 1,NTIBF+2			; remove padding characters from count
	MOVNS NTIBF+2			; SUBM goes the wrong way
	SKIPE 1				; maybe no adjustment necessary
NTIC1A:	IBP NTIBF+1
	SOJG 1,NTIC1A			; increment byte ptr given nbr of bytes
	MOVN 1,1(17)			; get # of characters back from stack
	LSH 1,3				; # of bits to shift over
	MOVE @NTIBF+1			; get word we are hacking
	LSH (1)				; right justify its bytes
	MOVEM @NTIBF+1			; store it back again
	JRST NTICH2			; now try it again
;⊗ NETOCH .NETOC

; NETOCH -- Output a character to the network
; Call:	MOVE <character>
;	PUSHJ 17,NETOCH
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0.

↑NETOCH:
IFN ERRHAN,<
	PUSHJ 17,.NETOC
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.NETOC:	SOSG NTOBF+2			; space available in buffer?
	 OUT NET,			; no, output it
	  CAIA				; win
	   JRST NETOER
	IDPB NTOBF+1			; put character in buffer
	SKIPE NWKDBG
	 OUTCHR
	JRST CPOPJ1			; success
;⊗ NETSND .NETSN NETOER

; NETSND -- Force network buffer out
; Call:	PUSHJ 17,NETSND
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

↑NETSND:
IFN ERRHAN,<
	PUSHJ 17,.NETSN
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.NETSN:	LDB 1,[410300,,NTOBF+1]		; get position field
	MOVEI 1
	LSH (1)				; AC0 ← 2↑<# of null characters>
	SOS				; AC0 ← mask to flush nulls
	IORM @NTOBF+1			; ensure padding nulls aren't sent
	OUT NET,			; send the buffer
	 JRST [	AOS NTOBF+2		; poor NETOCH will lose big otherwise
		JRST CPOPJ1]
NETOER:	GETSTS NET,			; lost, get status
	POPJ 17,			; and return
;⊗ DATICH DATICW DTICH2 DTICH3 DTICH1 DTIC1A

; DATICH/DATICW -- Read a character from the network data channel
; Call:	PUSHJ 17,DATICH or PUSHJ 17,DATICW
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<error return--no characters available> iff DATICH
;	<return--character in 0>
; Smashes 0, 1, and 2.

IFN DATRTS,<

↑DATICH:TDZA 2,2			; don't hang
↑DATICW: SETO 2,			; hang
IFN ERRHAN,<
	PUSHJ 17,DTICH2
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	 POPJ 17,			; DATICW or empty DATICH
	JRST CPOPJ1			; DATICH return
>; End IFN ERRHAN
DTICH2:	SOSLE DTIBF+2			; anything in buffer?
	 JRST DTICH3
	JUMPE 2,[	HRRZ 1,DTIBF
			HRRZ 1,(1)
			SKIPGE (1)	; anything in further buffers?
			 JRST .+1
			MTAPE DAT,[10]	; no, any input available?
			 JRST CPOPJ1	; no, empty error return
			JRST .+1]	; input available or hang
	IN DAT,				; yes, read the buffer
	 JRST DTICH3			; won
	GETSTS DAT,			; error, get status
	POPJ 17,			; I/O error return
DTICH3:	LDB [300600,,DTIBF+1]		; get byte size
	CAIE =8
	 JRST [	ILDB DTIBF+1		; non-ASCII data mode
		JUMPN 2,CPOPJ1
		JRST CPOPJ2]
	IBP DTIBF+1			; increment pointer to hack
	MOVE @DTIBF+1			; get word to hack
	ANDI 17 			; only marking bits
	JFFO DTICH1			; count leading zeros
	LDB DTIBF+1			; get the character
	JUMPN 2,CPOPJ1			; DATICW only skips once
	JRST CPOPJ2			; DATICH good return

; Have to flush nulls here.

DTICH1:	MOVNI 1,-44(1)			; get -1,,# of padding characters
	HRRZM 1,1(17)			; stash # of characters away on stack
	MOVEI 1,-1(1)			; # of characters to take off buffer
	SUBM 1,DTIBF+2			; remove padding characters from count
	MOVNS DTIBF+2			; SUBM goes the wrong way
	SKIPE 1				; maybe no adjustment necessary
DTIC1A:	IBP DTIBF+1
	SOJG 1,DTIC1A			; increment byte ptr given nbr of bytes
	MOVN 1,1(17)			; get # of characters back from stack
	LSH 1,3				; # of bits to shift over
	MOVE @DTIBF+1			; get word we are hacking
	LSH (1)				; right justify its bytes
	MOVEM @DTIBF+1			; store it back again
	JRST DTICH2			; now try it again
;⊗ DATOCH .DATOC

; DATOCH -- Output a character to the network data channel
; Call:	MOVE <character>
;	PUSHJ 17,DATOCH
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0.

↑DATOCH:
IFN ERRHAN,<
	PUSHJ 17,.DATOC
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.DATOC:	SOSG DTOBF+2			; space available in buffer?
	 OUT DAT,			; no, output it
	  CAIA				; win
	   JRST DATOER
	IDPB DTOBF+1			; put character in buffer
	JRST CPOPJ1			; success
;⊗ DATSND .DATSN DATOER

; DATSND -- Force network buffer out
; Call:	PUSHJ 17,DATSND
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

↑DATSND:
IFN ERRHAN,<
	PUSHJ 17,.DATSN
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.DATSN:	LDB 1,[410300,,DTOBF+1]		; get position field
	MOVEI 1
	LSH (1)				; AC0 ← 2↑<# of null characters>
	SOS				; AC0 ← mask to flush nulls
	IORM @DTOBF+1			; ensure padding nulls aren't sent
	OUT DAT,			; send the buffer
	 JRST [	AOS DTOBF+2		; poor NETOCH will lose big otherwise
		JRST CPOPJ1]
DATOER:	GETSTS DAT,			; lost, get status
	POPJ 17,			; and return

>; End IFN DATRTS
;⊗ CLOSER CLSDAT

; CLOSER/CLSDAT -- Close a connection
; Call:	PUSHJ 17,CLOSER or PUSHJ 17,CLSDAT
;	<return>
; Smashes 0.

↑CLOSER:CLOSE NET,
	RELEASE NET,
	OUTSTR [ASCIZ/
Connection closed.
/]
	POPJ 17,

IFN DATRTS,<

↑CLSDAT:CLOSE DAT,
	RELEASE DAT,
	POPJ 17,

>; End IFN DATRTS
;⊗ NETINR NETINS

; NETINR/NETINS -- Send network interrupts to TELNET connection
; Call:	PUSHJ 17,NETINR (or NETINS)
;	<return>
; Smashes 0.

↑NETINR:MTAPE NET,INRBLK		; interrupt from receiver
	POPJ 17,

↑NETINS:MTAPE NET,INSBLK		; interrupt from sender
	POPJ 17,

>; End IFN NIORTS
;⊗ MTPERR MTPER1 MTPE1A MERTAB MERLEN

; MTPERR -- Explain MTAPE lossage
; Call:	MOVE <MTAPE status bits>
;	PUSHJ 17,MTPERR
;	<return>
; Smashes 0 and 1.

IFN ERRTNS,<

↑↑MTPERR:TRNE 77			; UUO lossage?
	 JRST MTPER1			; yes, different message
	TLNN (CLSR)			; closed by foreign host?
	 SKIPA 1,[[ASCIZ/Time out
/]]
	  MOVEI 1,[ASCIZ/Refused
/]
	OUTSTR (1)
	CLRBFI
	POPJ 17,

; MTAPE UUO lossage

MTPER1:	ANDI 77				; only error code
	CAILE MERLEN			; error code too high?
	 JRST [	OUTSTR [ASCIZ/MTAPE error #/]
		IDIVI 10
		ADDI "0"
		ADDI 1,"0"
		OUTCHR
		OUTCHR 1
		JRST MTPE1A]
	CAIN 0,15			;Is it the "host dead" code?
	 JRST HSTDED			;Yes, say why
	MOVE 1,
	MOVE 1,MERTAB-1(1)		;Get word from table
	OUTSTR (1)			;Output the error string
	TLNN 1,600000			;Print crlf if not warning or fatal
	 OUTSTR [ASCIZ/
/]
	TLNE 1,400000			;Test for fatal error
	 JRST LUZBIG
	TLNE 1,200000			;Test for warning
MTPE1A:	 WARN
	CLRBFI
	POPJ 17,

;Bits in LH: 400000 if fatal error
;	     200000 if warning

MERTAB:	200000,,[ASCIZ/Socket in use/]
	200000,,[ASCIZ/Can't change socket/]
	200000,,[ASCIZ/System error/]		; horrible IMPSER bug; RTS&STR but no DDB
	[ASCIZ/No free links/]
	200000,,[ASCIZ/Illegal byte size/]
	[ASCIZ/IMP dead/]
	200000,,[ASCIZ/Gender mismatch/]	; the Anita Bryant feature
	;TOPS-10 error codes (from TCPSER.MAC[S,SYS]):
	200000,,[ASCIZ/State error/]				;(10)
	[ASCIZ/Connection was reset/]				;(11)
	[ASCIZ/Can't get there from here/]			;(12)
	400000,,[ASCIZ/Not enough internal buffer space/]	;(13)
	[ASCIZ/Illegal host number/]				;(14)
	[ASCIZ/Remote host down or not on net/]			;(15)
	[ASCIZ/Timeout/]					;(16)
	[ASCIZ/Destination net unreachable/]			;(17)
	[ASCIZ/Destination host unreachable/]			;(20)
	200000,,[ASCIZ/Destination protocol unreachable/]	;(21)
	[ASCIZ/Destination port unreachable/]			;(22)
	200000,,[ASCIZ/Fragmentation needed and DF set/]	;(23)
	200000,,[ASCIZ/Source route failed/]			;(24)
	200000,,[ASCIZ/Destination unreachable: unknown code/]	;(25)
MERLEN←←.-MERTAB
;⊗ NIOERR

; NIOERR -- Explain network I/O lossage
; Call:	MOVE <I/O status bits>
;	PUSHJ 17,NIOERR
;	<return>
; Smashes 0, 1, and 2.

↑NIOERR:ANDI ERRBTS			; only error bits
	SKIPN
	 FATAL No error status
	CLRBFI
	TRNE IOBKTL
	 FATAL Block too large
	TRNE IOIMPM
	 OUTSTR [ASCIZ/Connection closed
/]
	TRNE IODERR
	 OUTSTR [ASCIZ/Connection was reset
/]
	TRNE IODTER
	 OUTSTR [ASCIZ/Timeout
/]
	TRNE IODEND
	 OUTSTR [ASCIZ/Host closed connection
/]
	POPJ 17,
;⊗ HSTDED

; HSTDED -- Explain why a host is dead

HSTDED:	LDB [260400,,WHYWHY]		; get what's wrong first
	JUMPE [	OUTSTR [ASCIZ/Net trouble
/]
		POPJ 17,]		; 0 → destination IMP down
	CAIE 1				; 1 → destination host down
	 JRST [	CAIN 2			; 2 → destination host talks 32 bit leaders
		 JRST [ OUTSTR [ASCIZ/Communication with host not possible because it only talks 32 bit leaders
This probably indicates a hardware error at the other host, since 32-bit
leaders have been invalid since January 1, 1981.
/]
			POPJ 17,]
		cain 17			; Funny code from CONECT for bad net?
		 JRST [	OUTSTR [ASCIZ/Host net is inaccessible
/]
			POPJ 17,]
		OUTSTR [ASCIZ/Communication prohibited!
/]					; 3 → host access prohibited
		POPJ 17,]
	OUTSTR [ASCIZ/Host dead, /]
	LDB 1,[220400,,WHYWHY]		; dead host status
	OUTSTR @(1)[	[ASCIZ/random lossage/]
			[ASCIZ/system down/]
			[ASCIZ/foreign NCP down/]
			[ASCIZ/host doesn't exist/]
			[ASCIZ/NCP initialization/]
			[ASCIZ/scheduled PM/]
			[ASCIZ/hardware work/]
			[ASCIZ/software work/]
			[ASCIZ/emergency restart/]
			[ASCIZ/power failure/]
			[ASCIZ/software breakpoint/]
			[ASCIZ/hardware error/]
			[ASCIZ/scheduled down/]
			[ASCIZ/down code #13/]
			[ASCIZ/down code #14/]
			[ASCIZ/coming up now/]]
	OUTSTR [ASCIZ/
/]
;⊗ HSTDE2

; Hairy "when host up" code

	LDB [061400,,WHYWHY]		; get time when back up
	JUMPE CPOPJ
	CAIN 7776			; -2 → unknown future time
	 POPJ 17,
	OUTSTR [ASCIZ/  Host is expected back up /]
	CAIN 7777			; -1 → more than a week
	 JRST [	OUTSTR [ASCIZ/over a week from now./]
		POPJ 17,]
	LDB 1,[040500,,0]		; 1.5→1.9 hours
	LDB 2,[110300,,0]		; 2.1→2.3 day of week
	SUBI 1,=8			; PST/GMT offset
	MOVEI 3,261			; DAYLIT
	PEEK 3,
	PEEK 3,
	SKIPE 3
	 AOSL 1				; daylight losing time
	  JUMPGE 1,HSTDE2
	ADDI 1,=24			; hours become positive again
	SOJGE 2,HSTDE2			; back up a day
	SETZ 2,				; back to Monday
HSTDE2:	OUTSTR @(2)[	[ASCIZ/on Monday at /]
			[ASCIZ/on Tuesday at /]
			[ASCIZ/on Wednesday at /]
			[ASCIZ/on Thursday at /]
			[ASCIZ/on Friday at /]
			[ASCIZ/on Saturday at /]
			[ASCIZ/on Sunday at /]
			[ASCIZ/on April Fool's Day at /]]
	IDIVI 1,=10
	ADDI 1,"0"
	OUTCHR 1
	ADDI 2,"0"
	OUTCHR 2
	OUTCHR [":"]
	LDB 1,[000400,,0]		; 1.1→1.4 minutes/5
	IMULI 1,5.			; make into real minutes
	IDIVI 1,=10
	ADDI 1,"0"
	OUTCHR 1
	ADDI 2,"0"
	OUTCHR 2
	JUMPE 3,[	OUTSTR [ASCIZ/ PST
/]
			POPJ 17,]
	OUTSTR [ASCIZ/ PDT
/]
	POPJ 17,

>; End IFN ERRTNS
;⊗ HSTSID HSTFN1 HSTVRS HSTDIR HSTMCH HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV SITLEN NMLSIT NMRNAM NAMLEN NW%CHS NW%ARP NW%RCC NW%DLN NW%DSK NW%LCS NW%SU NW$BYT HSTFIL HSTPPN HSTSID HSTFN1 HSTVRS HSTDIR HSTDEV HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NTNPTR HDRLEN NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADLXXX ADRSVC SVLCNT SVRCDR SVLFLG SVRNAM SVCARG ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV STFGWY SITLEN NMLSIT NMRNAM NAMLEN NNLNET NNRNAM NTNLEN HSTFIL HSTPPN

; Host table routines

IFN HSTTAB,<

IFE FTHST3,<
;The format of the compiled HOSTS2 file is:
HSTSID←←0	; wd 0	SIXBIT /HOSTS2/
HSTFN1←←1	; wd 1	SIXBIT /HOSTS/ usually
HSTVRS←←2	; wd 2	FN2 of HOSTS file which this was compiled from.
HSTDIR←←3	; wd 3  SIXBIT /SYSENG/ usually, directory name of source file
HSTMCH←←4	; wd 4  SIXBIT /AI/ (e.g.), device name of source file
HSTWHO←←5	; wd 5	UNAME of person who compiled this
HSTDAT←←6	; wd 6	Date of compilation as sixbit YYMMDD
HSTTIM←←7	; wd 7	Time of compilation as sixbit HHMMSS
NAMPTR←←10	; wd 10 Address in file of NAME table.
SITPTR←←11	; wd 11	Address in file of SITE table.
NETPTR←←12	; wd 12 Address in file of NETWORK table.
		;....expandable....

;NETWORK table
; wd 0	Number of entries in table.
; wd 1	Number of words per entry. (2)
;This table contains one entry for each network known about, sorted
;alphabetically.  A network number is bits 4.8-4.1 of a network
;address; these numbers are assigned by Jon Postel.  See symbols below.
;The reason for keeping track of different networks is that the user
;program must make different system calls to use each network.
;Each entry contains:
NETNUM←←0	; wd 0	network number
NTLNAM←←1	; wd 1 LH - address in file of name of network
NTRTAB←←1	; wd 1 RH - address in file of network's address table
 NETLEN←←2

;ADDRESS table(s)
; wd 0	Number of entries in table.
; wd 1	Number of words per entry. (2)
;There is one of these tables for each network.  It contains entries
;for each site attached to that network, sorted by network address.
;These tables are used to convert a numeric address into a host name.
;Also, the list of network addresses for a site is stored
;within these tables.
;Each entry contains:
ADDADR←←0	; wd 0	Network address of this entry (including network number).
ADLSIT←←1	; wd 1 LH - address in file of SITE table entry
ADRCDR←←1	; wd 1 RH - address in file of next ADDRESS entry for this site
		;	    0 = end of list
 ADDLEN←←2

;SITE table
; wd 0	Number of entries in table.
; wd 1	Number of words per entry. (3)
;This table contains entries for each network site,
;not sorted by anything in particular.  A site can have more
;than one network address, usually on different networks.
;This is the main, central table.
;Each entry looks like:
STLNAM←←0	; wd 0 LH - address in file of official host name
STRADR←←0	; wd 0 RH - address in file of first ADDRESS table entry for this
		;	    site.  Successive entries are threaded together
		;	    through ADRCDR.
STLSYS←←1	; wd 1 LH - address in file of system name (ITS, TIP, TENEX, etc.)
		;			May be 0 means not known.
STRMCH←←1	; wd 1 RH - address in file of machine name (PDP10, etc.)
		;			May be 0 means not known.
STLFLG←←2	; wd 2 LH - flags:
STFSRV←←400000	;	4.9 1 means server site (according to NIC)
		; wd 2 RH - not used
 SITLEN←←3

;NAMES table:
; wd 0	Number of entries
; wd 1	Number of words per entry. (1)
;This table is used to convert host names into network addresses.  It
;contains entries sorted alphabetically by host name.
NMLSIT←←0	; lh	address in file of SITE table entry for this host.
NMRNAM←←0	; rh	address in file of host name
		;This name is official if NMRNAM = STLNAM of NMLSIT.
 NAMLEN←←1

; All names are ASCIZ strings, all letters upper case.
; The strings are stored before, after and between the tables.
; All strings are word-aligned, and fully zero-filled in the last word.

;Network addresses are defined as follows, for purposes of this table:
;    4.9     0
;    4.8-4.1 network number
;    Chaos net (number 7):
;	3.9-2.8	0
;	2.7-1.1 address (2.7-1.9 subnet, 1.8-1.1 host)
;    Arpa net (number 12):	(note, old-format Arpanet addresses
;    & BBN-RCCnet (number 3):	 never appear in the host table.)
;	3.9-3.8	0
;	3.7-2.1	Imp
;	1.9	0
;	1.8-1.1	Host
;    Dialnet (number 26):
;	3.9-3.1	0
;	2.9-1.1	address in file of ASCIZ string of phone number
;    LCSnet (number 22):
;	3.9	0
;	3.8-3.1	Subnet
;	2.9-1.9	0
;	1.8-1.1	Host
;    SU net (number 44):
;	3.9-2.8	0
;	2.7-1.1 address (2.7-1.9 subnet, 1.8-1.1 host)

↑NW%CHS←←7	;Chaos net
↑NW%ARP←←12	;Arpa net
↑NW%RCC←←3	;BBN-RCCnet
↑NW%DLN←←26	;Dialnet
↑NW%DSK←←777	;DSKnet
↑NW%LCS←←22	;LCSnet
↑NW%SU←←44	;SUnet
↑NW$BYT←←331100	;Byte pointer to network number

;Other network address formats accepted elsewhere:

;A network number of 0 defaults the network according to context.  "Old
;format" Arpanet addresses, of the form 1.8-1.7 host, 1.6-1.1 IMP

;The host-table compiler assumes Arpanet if the network number is
;zero, and converts old format Arpanet addresses to new format.  The
;NETWRK routines for accessing this table assume a network (for number
;zero) which depends on a program switch, and convert old format Arpa
;net addresses to new format.  There will also be a program switch for
;which networks are allowed to be returned from a host name lookup.

;The ITS Arpanet software accepts addresses with or without the network
;number; if the network number is non-zero it must be 12(octal).  The
;network number is not returned by the system.  ITS accepts either old
;or new format addresses, and returns the old format whenever possible.

;The ITS CHAOS net software always inputs and outputs addresses in
;16-bit bytes, so the network number issue does not arise.

;Dialnet addresses are always ASCIZ strings.

;LCSnet addresses are in the form subnet/host, in octal.

HSTFIL:	SIXBIT/HOSTS2/		;filename and extension of binary file
	SIXBIT/BIN/
HSTPPN:	SIXBIT/HSTNET/		;PPN of binary file
>;IFE FTHST3

IFN FTHST3,<
; Herein is the description of the compiled binary file (HOSTS3.BIN).
; General terms:
;	"fileaddr" = a file address, relative to start of file.
;	"netaddr" = a network address, in HOSTS3 format.
;
; All strings (hostnames etc) are uppercase ASCIZ, word-aligned and
; fully zero-filled in the last word.  The strings are stored in the
; file in such a way that their locations are sorted, and only ONE
; copy of any distinct string is stored - everything that references
; the same string points to the same place.  Thus it is reasonable to
; compare string pointers for = as well as < and >, which is much
; faster than comparing the strings.

;The format of the compiled output file is:

HSTSID←←0	; wd 0	SIXBIT /HOSTS3/
HSTFN1←←1	; wd 1	SIXBIT FN1 of source file (eg HOSTS)
HSTVRS←←2	; wd 2	SIXBIT FN2 of source file (TNX: version #)
HSTDIR←←3	; wd 3  SIXBIT directory name of source file (eg SYSENG)
HSTDEV←←4	; wd 4  SIXBIT device name of source file (eg AI)
HSTWHO←←5	; wd 5	SIXBIT login name of person who compiled this
HSTDAT←←6	; wd 6  SIXBIT Date of compilation as YYMMDD
HSTTIM←←7	; wd 7	SIXBIT Time of compilation as HHMMSS
NAMPTR←←10	; wd 10 Fileaddress of NAME table.
SITPTR←←11	; wd 11	Fileaddress of SITE table.
NETPTR←←12	; wd 12 Fileaddress of NETWORK table.
NTNPTR←←13	; wd 13 Fileaddress of NETNAME table.
		;....expandable....
  HDRLEN←←14	; length of header

; NETWORK table
;	wd 0	Number of entries in table.
;	wd 1	Number of words per entry. (2)
; This table contains one entry for each known network.
; It is sorted by network number.
; Each entry contains:

NETNUM←←0	; wd 0 network number (full netaddr)
NTLNAM←←1	; wd 1 LH - fileaddr of ASCIZ name of network
NTRTAB←←1	; wd 1 RH - fileaddr of network's ADDRESS table
 NETLEN←←2

; ADDRESS table(s)
;	wd 0	Number of entries in table.
;	wd 1	Number of words per entry. (3)
; There is one of these tables for each network.  It contains entries
; for each site attached to that network, sorted by network address.
; These tables are used to convert a numeric address into a host name.
; Also, the list of network addresses and services for a site is stored
; within these tables.
; Each entry contains:

ADDADR←←0	; wd 0	Network address of this entry, in HOSTS3 fmt.
ADLSIT←←1	; wd 1 LH - fileaddr of SITE table entry
ADRCDR←←1	; wd 1 RH - fileaddr of next ADDRESS entry for this site
		;	 0 = end of list
ADLXXX←←2	; wd 2 LH - unused
ADRSVC←←2	; wd 2 RH - fileaddr of services list for this address
		;	0 = none, else points to SERVICE node of format:
	SVLCNT←←0	;		<# wds>,,<fileaddr of next, or 0>
	SVRCDR←←0
	SVLFLG←←1	;		<flags>,,<fileaddr of svc name>
	SVRNAM←←1
	SVCARG←←2	;		<param1> ? <param2> ? ...
 ADDLEN←←3

; SITE table
;	wd 0	Number of entries in table.
;	wd 1	Number of words per entry. (3)
; This table contains entries for each network site,
; not sorted by anything in particular. A site can have more
; than one network address, usually on different networks.
; This is the main, central table.
; Each entry looks like:

STLNAM←←0	; wd 0 LH - fileaddr of official host name
STRADR←←0	; wd 0 RH - fileaddr of first ADDRESS table entry for this
		;		site.  Successive entries are threaded
		;		together through ADRCDR.
STLSYS←←1	; wd 1 LH - fileaddr of system name (ITS, TIP, TENEX, etc.)
		;		May be 0 → not known.
STRMCH←←1	; wd 1 RH - fileaddr of machine name (PDP10, etc.)
		;		May be 0 → not known.
STLFLG←←2	; wd 2 LH - flags:
STFSRV←←400000	;	4.9 1 → server site (has FTP or TELNET)
STFGWY←←200000	;	4.8 1 → Internet Gateway site (HOSTS3 only)
 SITLEN←←3

; NAMES table:
;	wd 0	Number of entries
;	wd 1	Number of words per entry. (1)
; This table is used to convert host names into network addresses.  It
; contains entries sorted alphabetically by host name.

NMLSIT←←0	; wd 0 LH - fileaddr of SITE table entry for this host.
NMRNAM←←0	; wd 0 RH - fileaddr of host name
		; This name is official if NMRNAM = STLNAM of NMLSIT.
 NAMLEN←←1

; NETNAME table:
;	wd 0	Number of entries
;	wd 1	Number of words per entry. (1)
; This table is used to convert network names into network numbers.  It
; contains entries sorted alphabetically by network name, exactly as
; for the NAMES table.  Although the symbols below are different (in order
; to make semantic distinctions), programs can depend on the fact
; that the NETNAME table format is identical to that of the NAMES table.

NNLNET←←0	; wd 0 LH - fileaddr of NETWORK table entry for this host.
NNRNAM←←0	; wd 0 RH - fileaddr of network name
 NTNLEN←←1

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;		HOSTS3 Network Address Format           ;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

comment |
HOSTS3 network address format:

   4.9-4.6 - 4 bits of format type, which specify interpretation of
		the remaining 32 bits.
IN	0000 - Internet address (handles ARPA, RCC, LCS)
		4.5-1.1 - 32 bits of IN address.
UN	0001 - Unternet address.  Same format, but not part of Internet.
		4.5-3.7 - HOSTS3-defined network number (1st 8-bit byte)
		3.6-1.1 - address value in next 24 bits.
			This handles CHAOS and any local nets.  The network
			numbers are unique within the HOSTS3 table but
			don't necessarily mean anything globally, as do
			Internet network numbers.
	0011 - String address.
		4.5-3.7 - HOSTS3-defined network number (1st 8-bit byte)
		3.6-3.1 - 0
		2.9-1.1 - address of ASCIZ string in file/process space

Note that the "network number" for all of these formats is located in
the same place.  However, for fast deciphering of the entire range of
possibilities, one could simply consider all of the high 12 bits as the
network number.  Beware of the Internet class A, B, and C formats, though;
the only truly general way to compare network numbers is to use their
masked 36-bit values, although simpler checks are OK for specific nets.
For this reason (among others) network numbers are represented by
full 36-bit values with the "local address" portion zero.

The 4-bit "String address" value is much more tentative than the IN or UN
values.  Bit 4.9, the sign bit, is being reserved as usual for the possible
advent of a truly spectacular incompatible format.
|

HSTFIL:	SIXBIT/HOSTS3/		;filename and extension of binary file
	SIXBIT/BIN/
HSTPPN:	SIXBIT/HSTNET/		;PPN of binary file
>;IFN FTHST3
;⊗ MAPHST

; MAPHST -- Map host table into core
; Call:	PUSHJ 17,MAPHST
;	<return>
; Smashes 0, 1, 2, and 3.

↑MAPHST:SKIPE HSTADR
	 JRST [	WARN Host table already mapped
		POPJ 17,]
	INIT 17
	 ('DSK')
	 0
	 FATAL DSK INIT failure
	DMOVE 0,HSTFIL
	MOVE 3,HSTPPN
	LOOKUP
	 JRST [	OUTSTR [ASCIZ/Host table LOOKUP failure (/]
		ANDI 1,77
		IDIVI 1,10
		ADDI 1,"0" ↔ ADDI 2,"0"
		OUTCHR 1 ↔ OUTCHR 2 ↔ OUTCHR [")"]
		JRST LUZBIG]
	MOVE 2,JOBFF↑
	MOVS 3 ↔ MOVN ↔ ADDB JOBFF↑	; get address of highest addr we need
	MOVEM HSTTOP
	CORE				; get more core from system maybe
	 FATAL CORE UUO failure
	MOVE 3 ↔ HRRI -1(2)		; compute IOWD to read host table in
	SETZ 1,
	INPUT
	MOVE (2)			; get first word of host table
	CAME HSTFIL
	 FATAL Bad host table
	MOVEM 2,HSTADR			; remember where host table begins
	RELEAS
	POPJ 17,
;⊗ UNMHST

; UNMHST -- Unmap host table from core
; Call:	PUSHJ 17,UNMHST
;	<return>
; Smashes 0 and 1.

↑UNMHST:SKIPN 1,HSTADR			; host table in core?
	 JRST [	WARN Host table not mapped
		POPJ 17,]
	MOVE (1)
	CAME HSTFIL
	 FATAL Bad host table
	MOVE HSTTOP			; check JOBFF from before
	CAMLE JOBFF↑			; smashed too?
	 FATAL Host table after JOBFF
	CAME JOBFF↑
	 JRST [	WARN Host table locked
		POPJ 17,]
	SETZM HSTADR			; remove table pointer/interlock
	MOVEM 1,JOBFF↑			; return host table to free storage
	CORE 1,				; and garbage collect
	 FATAL CORE UUO failure
	POPJ 17,
;⊗ HSTNUM HSTNU0 HSTNUS HSTNU1 HSTNU2 HSTNU3 HSTNU4 HSTNU5 HSTNUD HSTNUO HSTNU9

; HSTNUM -- Return descriptor block for a host
; Call:	MOVEI <host number>
;	PUSHJ 17,HSTNUM
;	<error return--no such host>
;	<return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2>
; Smashes 0, 1, 2, 3, and 4.

↑HSTNUM:SKIPN 1,HSTADR			; fail if host table not mapped
	 FATAL Host table not mapped
	MOVE 2,(1)
	CAME 2,HSTFIL
	 FATAL Bad host table
IFE FTHST3,<
;Someone at MIT changed Ethernet host number format.  I claim no resp.  TVR/Dec82
ifn 1,<	;turned (back?) on by ME 1/4/83
	ldb 2,[nw$byt,,0]
	cain 2,nw%su			; *** Screwed up HOSTS2?
	 jrst [	ldb 2,[101100,,0]		; *** Perhaps
		caig 2,77			; *** Properly justified?
		  lsh 2,1			; ***	Sigh, patch it up!
		dpb 2,[101100,,0]
		jrst hstnu0 ]
>;ifn 1
	CAILE 377			; old style host?
	 JRST HSTNU0
	DPB [170600,,]			; convert to new style
	LSH -6
HSTNU0:	LDB 4,[NW$BYT,,0]		; get network number
	SKIPN 4				; if none given, assume ARPANet
	  MOVEI 4,NW%ARP
	DPB 4,[NW$BYT,,0]		; set network number if none
>;IFE FTHST3
IFN FTHST3,<
	GETNET 4,0			; get network number
	SKIPN 4
	 TLO 0,(NW%ARP)			; if none given, assume ARPANet
>;IFN FTHST3
	MOVE 1,NETPTR(1)
	PUSHJ 17,HSTNUS			; lookup network number
	  POPJ 17,
	MOVE 1,NTRTAB(1)		; get address table for network
	MOVEM 4				; thing to search for
	PUSHJ 17,HSTNUS			; lookup address
	  POPJ 17,
	HLRZ 1,ADLSIT(1)		; get site table entry
	ADD 1,HSTADR
	AOS (17)			; successful return
	JRST GETHDB			; return useful stuff in ACs

HSTNUS:	ADD 1,HSTADR			; relocate table
	MOVE 2,(1)			; get # of entries
	MOVE 3,1(1)			; and entry size
	ADDI 1,2			; point at first entry
HSTNU1:	CAMN 4,(1)			; found it?
	  JRST CPOPJ1			;   yes, skip return for success
	ADD 1,3				; point at next entry
	SOJG 2,HSTNU1			; keep on searching
;Here if host not in our host table.  Generate ASCIZ string for host number
;instead of name.
	MOVE 1,[440700,,DHSTST]	;byte ptr for stuff in ASCIZ of dotted host number
	GETNET 4,0		;Get network number
	CAMN 4,[NW%SU]		;Is it the Ethernet?
	JRST HSTNU5		;Yes, generate subnet#host
	PUSH 17,[301000,,0]	;byte ptr to 2nd-4th bytes of host nbr (8 bits)
	LDB 2,[301400,,0]	;get first byte (bigger) of hst nbr (12 bits)
	JRST HSTNU3

HSTNU2:	MOVEI 2,"."		;insert dot between parts of host number
	IDPB 2,1		;stuff into host "name" string (actually host nbr)
	ILDB 2,(17)		;get next byte of host nbr
HSTNU3:	PUSHJ 17,HSTNUD		;convert to decimal string
	MOVE 2,(17)
	TLNE 2,770000		;end of word in byte ptr?
	JRST HSTNU2		;no, output more parts of host nbr
	ADJSP 17,-1		;flush byte ptr from stack
HSTNU4:	MOVEI 2,0
	IDPB 2,1		;terminate host string with a null
;Now we're ready to return from HSTNUM.  Set up return values.
	SETZM HDBPTR		;no HDB
	MOVEI 1,DHSTST		;pointer to dotted host number text
	SETZB 2,3
	POPJ 17,		;failure return

HSTNU5:	LDB 2,[101000,,0]	;Get subnet number
	PUSHJ 17,HSTNUO		;Convert to octal string
	MOVEI 2,"#"		;Insert delimiter
	IDPB 2,1
	LDB 2,[001000,,0]	;Get host number
	PUSHJ 17,HSTNUO		;Put in host number string
	JRST HSTNU4		;Finish up

HSTNUD:	SKIPA 4,[=10]		;Usual decimal output routine
HSTNUO:	MOVEI 4,10		;Octal output
HSTNU9:	IDIV 2,4
	HRLM 3,(17)
	JUMPE 2,.+2
	PUSHJ 17,HSTNUD
	HLRZ 3,(17)
	ADDI 3,"0"
	IDPB 3,1		;Stick digit into host string
	POPJ 17,
;⊗ HSTNAM CNTCHR

; HSTNAM -- Return descriptor block for a host name
; Call:	MOVEI <pointer to host name string>
;	PUSHJ 17,HSTNAM
;	<error return--no such host>
;	<error return--ambiguous name>
;	<return--absolute NUMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2
;	 next address block in 3>
; Smashes 0 → 11 (!!!).

↑HSTNAM:SKIPN 1,HSTADR			; fail if host table not mapped
	 FATAL Host table not mapped
	MOVE 2,(1)
	CAME 2,HSTFIL
	 FATAL Bad host table

;  Set up various AC's for hairy search below.  0 has a pointer to the input
; host, 1 has the host table pointer, 2 has the character count.

	MOVE 2,NAMPTR(1)
	ADD 2,HSTADR			; address of NAMES table
	HRLO 1,(2)			; # of entries,,-1
	EQVI 1,1(2)			; -<1+# of entries>,,table-1
	ADJSP 1,1			; now have AOJBN pointer to table
	MOVE 3,
	HRLI 3,440700			; make byte pointer
	SETZ 2,				; character count

; Compute character count in AC 2

CNTCHR:	ILDB 4,3
	JUMPE 4,[	JUMPE 2,CPOPJ	; null specification loses
			SETZB 3,4	; init pointers
			JRST SEARCH]
	CAIL 4,"a"			; lowercase?
	 SUBI 4,"a"-"A"
	DPB 4,3
	AOJA 2,CNTCHR
;⊗ SEARCH SRCNXW SRCWIN SRCLUZ SRCDUN GOTNAM AMBNAM GETHDB

; Host name search

SEARCH:	MOVEI 5,(2)			; copy of count
	MOVE 6,				; copy of source pointer
	HRRZ 7,(1)
	ADD 7,HSTADR			; pointer for this entry
SRCNXW:	MOVE 10,(7)
	MOVE 11,(6)
	ANDCMI 11,1			; 1.1 is a loser
	CAIL 5,=5			; account for this word
	 JRST [	CAME 10,11		; match for this word?
		 JRST SRCLUZ
		SUBI 5,=5		; match, account for this word
		ADDI 7,1
		AOJA 6,SRCNXW]		; still more to go
	AND 11,[BYTE (7)000,000,000,000,000
		BYTE (7)177,000,000,000,000
		BYTE (7)177,177,000,000,000
		BYTE (7)177,177,177,000,000
		BYTE (7)177,177,177,177,000](5)
	CAMN 10,11			; exact match?
	 JRST [	HLRZ 1,(1) ↔ ADD 1,HSTADR
		JRST GOTNAM]		; stop the presses!
	SOJL 5,SRCWIN			; this string ends on word boundry
	AND 10,[BYTE (7)177,000,000,000,000
		BYTE (7)177,177,000,000,000
		BYTE (7)177,177,177,000,000
		BYTE (7)177,177,177,177,000](5)
	CAME 10,11			; match for partial word?
	 JRST SRCLUZ
SRCWIN:	HLRZ 5,(1) ↔ ADD 5,HSTADR	; set up pointer to HDB
	MOVE 6,2(5)			; NUMBTS
	TLNE 6,STFSRV			; server?
	 JRST [	CAMN 3,5		; all self-matches win
		 JRST SRCLUZ
		SKIPE 3			; somebody there?
		 TLOA 3,-1		; yah, loser
		  MOVE 3,5		; else remember the name
		AOBJN 1,SEARCH		; keep on hunting
		JRST SRCDUN]		; else done
	CAMN 4,5			; self-matcher?
	 JRST SRCLUZ
	SKIPE 4				; already seen a user?
	 TLOA 4,-1			; remember can't be a user
	  MOVE 4,5			; else remember the pointer
SRCLUZ:	AOBJN 1,SEARCH			; maybe could be a server in there

; Search done, set up HDB ala HSTNUM and return

SRCDUN:	SKIPN 1,3			; use server if found one
	 MOVE 1,4			; no server, maybe a user
	JUMPE 1,CPOPJ			; no match at all
	SKIPL 1				; ambiguous name?
GOTNAM:	 AOS (17)			; no, set up double skip return
AMBNAM:	AOS (17)			; ordinary skip return

; Routine to get a block of host specifications with pointer in 1.

	HRRZ 3,STRADR(1)		; get address block
	ADD 3,HSTADR
	MOVE ADDADR(3)			; host number
	HRRZ 3,ADRCDR(3)		; get other address(es), if any
IFE FTHST3,<
	ldb 2,[nw$byt,,0]
	cain 2,nw%su			; *** Screwed up HOSTS2?
	 pushj 17,[ldb 2,[101100,,0]		; *** Perhaps
		caile 2,77			; *** Too big?
		  lsh 2,-1			; ***	Sigh, patch it up!
		dpb 2,[101100,,0]
		popj 17, ]
	CAILE 377			; old style host?
	 JRST GETHDB
	DPB [170600,,]			; convert to new style
	LSH -6
>;IFE FTHST3
GETHDB:	MOVE 2,STRMCH(1)		; NUMBTS,,NUMMCH
	HLL 2,STLFLG(1)
	TRNE 2,-1
	 ADD 2,HSTADR
	MOVEM 1,HDBPTR			; save pointer to HDB
	SUB 1,HSTADR
	EXCH 1,HDBPTR
	HLL 1,STLSYS(1)
	HLR 1,STLNAM(1)			; NUMSYS,,NUMNAM
	TLNN 1,-1
	 JRST [	ADD 1,HSTADR		; case of unknown system name
		POPJ 17,]
	ADJSP 1,@HSTADR
	POPJ 17,			; and return
;⊗ HSTNXA

; HSTNXA -- Return descriptor block for a host
; Call:	MOVE 3,<number return by HSTNAM as next address block>
;	PUSHJ 17,HSTNXA
;	<error return--no other addresses>
;	<return--absolute NAMNUM in 0, next address block in 3>
; Does not disturb 1,2

↑HSTNXA:
	SKIPN HSTADR			; fail if host table not mapped
	 FATAL Host table not mapped
	MOVE 0,@HSTADR
	CAME 0,HSTFIL
	 FATAL Bad host table
	JUMPE 3,[ SETZ 0,		; if no addresses left, fail
		  POPJ 17,]
	ADD 3,HSTADR
	MOVE 0,ADDADR(3)		; get this address
IFE FTHST3,<
	push 17,2
	ldb 2,[nw$byt,,0]
	cain 2,nw%su			; *** Screwed up HOSTS2?
	 pushj 17,[ldb 2,[101100,,0]		; *** Perhaps
		  caile 2,77			; *** Too big?
		    lsh 2,-1			; ***	Sigh, patch it up!
		  dpb 2,[101100,,0]
		  popj 17, ]
	pop 17,2
>;IFE FTHST3
	HRRZ 3,ADRCDR(3)		; get other address(es), if any
	AOS (17)
	POPJ 17,			; failure
;⊗ SETANM SETA00 SETAN1 SETAN0 SETAN2 SETAN4 SETAN5 SETAN9 SETAN6 SETAN7 SETAN8

; SETANM -- Generate alias name from host name
; Call:	<call to HSTNUM or HSTNAM to set up HDB pointer>
;	PUSHJ 17,SETANM
; Smashes 0 → 7 (!!!).

IFN HSTSIX,<

↑SETANM:HRRZ 6,1			; check official name first (or dotted nbr)
	SKIPN 1,HDBPTR
	 JRST SETA00			; no host was found, use dotted host nbr
	MOVE 2,HSTADR
	HRRZ 2,NAMPTR(2)		; get address of NAMES table.
	ADD 2,HSTADR
	SKIPA 3,(2)			; number of entries in the table.
SETA00:	MOVEI 3,0			; no match earlier, don't look again
	SETOB 4,5			; 4 ← longest name ≤ 6 chars, 5 ← length
	AOJA 2,SETAN0			; skip word 1 of table (entry length)

SETAN1:	ADDI 2,1			; next untried NAMES table entry.
	HLRZ 6,(2)
	CAME 6,1			; name the host we are serving?
	 JRST SETAN4
	HRRZ 6,(2)			; how long is this name?
	ADD 6,HSTADR
SETAN0:	HRLI 6,440700
	PUSH 17,6
	PUSH 17,6
	SETZ 7,
SETAN2:	ILDB 6,(17)
	SKIPE 6
	 AOJA 7,SETAN2

	POP 17,6			; flush garbage
	POP 17,6			; restore pointer to name
	CAIG 7,6			; fit in 6 characters?
	 CAMG 7,4			; and longer than the previous one?
	  JRST SETAN4
	HRRZ 5,6			; save name's address
	MOVE 4,7			; and the length
SETAN4:	SOJG 3,SETAN1			; look through the rest of the table.
	JUMPGE 4,SETAN5			; jump if found a reasonable name
	MOVEI 4,"-"			; also, will remove hyphens from it
	SKIPN 5,HDBPTR
	JRST SETAN9			; no host name at all, using dotted nbr
	ADD 5,HSTADR			; no short name, truncate official one
	HLRZ 5,STLNAM(5)
	ADD 5,HSTADR			; pointer to name
SETAN5:	SKIPA 2,5
SETAN9:	MOVEI 2,(6)			; ptr to dotted host number string
	HRLI 2,440700			; get BP to name string.
	MOVSI 1,440600
	SETZ 0,				; convert name to SIXBIT word in 0
SETAN6:	ILDB 3,2
	JUMPE 3,SETAN7			; stop if name string runs out
	CAMN 3,4			; remove hyphens if requested to
	 JRST SETAN6			; note 4 has number from 1 to 6 or "-"
	SUBI 3," "-' '
	IDPB 3,1
	TLNE 1,770000			; stop after getting one full word.
	 JRST SETAN6
SETAN7:	LDB 3,1				; if last character is a hyphen, flush it.
	CAIN 3,'-'
	 SETZ 3,
	DPB 3,1
SETAN8:	TRNN 0,-1			; if right half of "alias" is zero,
	 IORI '.'			;   then add a dot to make it "longer"
	SETO 1,
	GETLIN 1
	AOSN 1				; don't screw DSK PPN if not a phantom
	 DSKPPN
	POPJ 17,

>; End IFN HSTSIX

>; End IFN HSTTAB
;⊗ H2TOIP H2ARP H2ARP1 H2ARP2 H2SU

IFE FTHST3,<
; H2TOIP -- Convert HOSTS2-format address to IP address
; Call:	MOVE 0,<HOSTS2 address>
;	PUSHJ 17,H2TOIP
;	<error return--unable to convert>
;	<return--IP address in 0>

↑↑H2TOIP:
	PUSH 17,1
	LDB 1,[NW$BYT,,0]
	SKIPN 1
	 MOVEI 1,NW%ARP		;Default to ARPA
	CAIN 1,NW%ARP		;ARPA?
	 JRST H2ARP
	CAIN 1,NW%SU		;SU-Net?
	 JRST H2SU
	POP 17,1		;We don't know how to do this one
	POPJ 17,

H2ARP:	DPB 0,[311000,,0]	;Move host number to left of IMP
	LSH 0,-11		;Right-align IMP in word
H2ARP1:	DPB 1,[301000,,0]	;Include net number
H2ARP2:	POP 17,1
	JRST CPOPJ1

H2SU:
IFN 1,<				;This code is for SU-NET-TEMP (net 36.0.0.0)
	DPB 0,[341000,,0]	;Copy host number
	ROT 0,10		;Put subnet and host in place
	AND 0,[000077,,600377]	;Zero everything else
	JRST H2ARP1
>;IFN 1
IFN 0,<				;This code is for SU-NET (net 128.12.0.0)
	MOVEI 1,100014		;Get new net number
	DPB 1,[202400,,0]	;Overwrite old net number
	JRST H2ARP2
>;IFN 0
>;IFE FTHST3
;⊗ IPTOH2 IPTH2A IPARP IPARP1 IPSU

IFE FTHST3,<
; IPTOH2 -- Convert IP address to HOSTS2-format address
; Call:	MOVE 0,<IP address>
;	PUSHJ 17,IPTOH2
;	<error return--unable to convert>
;	<return--HOSTS2 address in 0>

↑↑IPTOH2:
	PUSH 17,1
	PUSH 17,2
	LDB 1,[301000,,0]	;Get 1st byte
	LDB 2,[202000,,0]	;Get 1st and 2nd bytes
	CAIN 1,NW%ARP		;ARPA?
	 JRST IPARP
IFN 1,<				;This code is for SU-NET-TEMP (net 36.0.0.0)
	CAIN 1,NW%SU		;SU-Net?
>;IFN 1
IFN 0,<				;This code is for SU-NET (net 128.12.0.0)
	CAIN 2,100014		;SU-Net?
>;IFN 0
	 JRST IPSU
;If not ARPA or SU-Net, return non-skip.
IPTH2A:	POP 17,2
	POP 17,1
	POPJ 17,

IPARP:	ANDI 0,177777		;Get just IMP number
	LSH 0,11		;Shift into place
	DPB 2,[001000,,0]	;Deposit host number
IPARP1:	DPB 1,[331000,,0]	;Deposit net number
	AOS -2(17)		;Set skip return
	JRST IPTH2A

IPSU:
IFN 1,<				;SU-NET-TEMP
	ANDI 0,377		;Get just host number
	DPB 2,[101000,,0]	;Deposit subnet number
	JRST IPARP1
>;IFN 1
IFN 0,<				;SU-NET
	ANDI 0,177777		;Get address
	MOVEI 1,NW%SU		;HOSTS2's number for SU-NET
	JRST IPARP1
>;IFN 0
>;IFE FTHST3
;⊗ CPOPJ2 CPOPJ1 CPOPJ WARNIN LUZBIG ..NLIT NW%ARP NW%SU NW$BYT

; All good things must come to an end

; Return routines

CPOPJ2:	AOS (17)			; double skip return
CPOPJ1:	AOS (17)			; skip return
CPOPJ:	POPJ 17,			; return to caller

; Warning

↑WARNIN:OUTSTR [ASCIZ/
Please report this via GRIPE.
/]
	POPJ 17,

; Fatality!

↑LUZBIG:OUTSTR [ASCIZ/
Find a wizard.
/]
	JRST 4,WARNIN

..NLIT:	LIT

IFE FTHST3,<
;Export these things (put here, so that entire definition page can be just
;recopied if we ever change to HOST3)
↑NW%ARP←←NW%ARP
↑NW%SU←←NW%SU
↑NW$BYT←←NW$BYTE
>;IFE FTHST3

BEND NETWRK